home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 August: Tool Chest / Dev.CD Aug 94.toast / Tool Chest / Development Platforms / Macintosh Common Lisp Related / User Contributions / applescript-from-lisp / applescript⁄appleevents / AppleScript Editor.lisp < prev    next >
Encoding:
Text File  |  1994-06-16  |  13.5 KB  |  373 lines  |  [TEXT/CCL2]
  1. (in-package "AS")
  2.  
  3. ;; file:  applescript-editor.lisp
  4. ;;  an applescript editor (duhh)
  5. ;;  TO DO:
  6. ;;  Need to check to insure that if the contents of the buffer have changed,
  7. ;;  before closing the editor, the applescript object gets the new changes - no
  8. ;;  big deal right now.
  9.  
  10. (require :scrolling-fred-dialog-item)
  11. (export '(*AS-SCRIPT-EDITOR* MAKE-APPLESCRIPT-EDITOR))
  12.  
  13.  
  14. (DEFVAR *AS-SCRIPT-EDITOR* NIL "Points to the applescript editor")
  15. (DEFVAR *BOGUS-SCRIPT* 
  16.   (concatenate 'string "tell application " (cl-user:make-literal-string "applicationName")
  17.                (format nil "~%") (format nil "~%") 
  18.                "end tell" (format nil "~%"))
  19.   )
  20. ;;  THis is where the script is actually written
  21. (DEFCLASS AS-INPUT-BUFFER (ccl::scrolling-fred-dialog-item)
  22.   ()
  23.   (:default-initargs 
  24.     :view-size #@(450 230)
  25.     :view-nick-name 'input-buffer
  26.     )
  27.   )
  28.  
  29. (DEFCLASS AS-EDITOR-WINDOW (window)
  30.   ((current.object :initarg :current-object :initform nil :accessor current-object)
  31.    )
  32.   (:default-initargs
  33.     :window-type :document-with-grow
  34.     :color-p t
  35.     :window-title "AppleScript Editor"
  36.     :view-position #@(50 100)
  37.     :view-size #@(500 300)
  38.     :close-box-p t
  39.     )
  40.   )
  41.  
  42. (DEFCLASS RUN-SCRIPT-BTN (ccl::button-dialog-item)
  43.   ()
  44.   (:default-initargs
  45.     :view-nick-name 'run-btn
  46.     :default-button nil
  47.     :dialog-item-text "Run Script"
  48.     :view-size #@(100 20)
  49.     :view-position #@(79 274)
  50.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  51.     )
  52.   )
  53.  
  54. (DEFMETHOD CCL::DIALOG-ITEM-ACTION ((btn run-script-btn))
  55.   ;;  enter the script into the applescript instance then compile and run the script.
  56.   (let* ((dialog (view-container btn))
  57.          (as-object (current-object dialog))
  58.          (script (extract-script-text (dialog-item-text (view-named 'input-buffer dialog)))))
  59.     ; set the script
  60.     (setf (script as-object) script)
  61.     (open-component as-object)
  62.     (compile-applescript as-object)
  63.     (execute-applescript as-object)
  64.     (if (check-box-checked-p (view-named 'show-result (view-container btn)))
  65.       (display-result as-object))
  66.     )
  67.   )
  68.  
  69. (DEFCLASS ADD-SCRIPT-BTN (ccl::button-dialog-item)
  70.   ()
  71.   (:default-initargs
  72.     :view-nick-name 'add-btn
  73.     :default-button t
  74.     :dialog-item-text "Add"
  75.     :view-size #@(100 20)
  76.     :view-position #@(183 273)
  77.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  78.     )
  79.   )
  80.  
  81. (DEFMETHOD CCL::DIALOG-ITEM-ACTION ((btn add-script-btn))
  82.   ;;  enter the script into the applescript instance then compile it.
  83.   (let* ((dialog (view-container btn))
  84.          (as-object (current-object dialog))
  85.          (script (dialog-item-text (view-named 'input-buffer dialog))))
  86.     ; set the script
  87.     (setf (script as-object) script)
  88.     ;; since we want to recompile the script set the compiled script id to nil
  89.     (setf (compiled-script-id as-object) nil)
  90.     ))
  91.  
  92. (DEFCLASS CANCEL-BTN (ccl::button-dialog-item)
  93.   ()
  94.   (:default-initargs
  95.     :view-nick-name 'cancel-btn
  96.     :default-button nil
  97.     :dialog-item-text "cancel"
  98.     :view-size #@(60 20)
  99.     :view-position #@(301 275)
  100.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  101.     )
  102.   )
  103.  
  104. (DEFMETHOD CCL::DIALOG-ITEM-ACTION ((btn cancel-btn))
  105.   ;;  punt
  106.   (let ((dialog (view-container btn)))
  107.     ; set the script
  108.     (set-dialog-item-text (view-named 'input-buffer dialog) "")
  109.     (setf (current-object dialog) nil)
  110.     ))
  111.  
  112.  
  113. (DEFMETHOD SHOW-SCRIPT ((window AS-EDITOR-WINDOW) &optional (script *bogus-script*))
  114.   ;;  shove the script in the AS-INPUT-BUFFER
  115.   (let ((input.buffer (view-named 'input-buffer window)))
  116.     (set-dialog-item-text input.buffer script)
  117.     )
  118.   )
  119.  
  120. (DEFUN MAKE-APPLESCRIPT-EDITOR (&optional as-object)
  121.   (cond ((and *AS-SCRIPT-EDITOR*
  122.               (wptr *AS-SCRIPT-EDITOR*))
  123.          (window-select *AS-SCRIPT-EDITOR*)
  124.          (setf (current-object *AS-SCRIPT-EDITOR*) as-object)
  125.          )
  126.         (t
  127.          (setf *AS-SCRIPT-EDITOR*
  128.                (make-instance 'as-editor-window))
  129.          (setf (current-object *AS-SCRIPT-EDITOR*) as-object)
  130.          (let* ((v-offset 20)
  131.                 (h-offset 15)
  132.                 (dialog-size (view-size *AS-SCRIPT-EDITOR*))
  133.                 (dialog-width (point-h dialog-size))
  134.                 (dialog-height (point-v dialog-size))
  135.                 (reserve-for-button 50)
  136.                 (button-margin (floor
  137.                                 (/ (- (point-h dialog-width)
  138.                                       280 ;sum of buttons
  139.                                       ) 2)))
  140.                 (run-button-position nil)
  141.                 (add-button-position nil)
  142.                 (cancel-button-position nil))
  143.            (setf run-button-position
  144.                  (make-point button-margin 
  145.                              (- dialog-height 25)))
  146.            (setf add-button-position 
  147.                  (make-point (+ 10 (point-h run-button-position)
  148.                                 100)
  149.                              (point-v run-button-position)))
  150.            (setf cancel-button-position
  151.                  (make-point (+ 10 (point-h add-button-position) 100)
  152.                              (point-v run-button-position)))
  153.            (add-subviews *AS-SCRIPT-EDITOR*
  154.                          (make-instance 'check-box-dialog-item
  155.                            :view-position #@(0 0)
  156.                            :dialog-item-text "Show The Result?"
  157.                            :check-box-checked-p t
  158.                            :view-nick-name 'show-result)
  159.                          (make-instance 'as-input-buffer
  160.                            :view-position (make-point 0 v-offset)
  161.                            :view-size (make-point 
  162.                                        (- dialog-width
  163.                                           h-offset)
  164.                                        (- dialog-height
  165.                                           v-offset
  166.                                           reserve-for-button)))
  167.                            (make-instance 'run-script-btn
  168.                              :view-position run-button-position)
  169.                            (make-instance 'add-script-btn
  170.                              :view-position add-button-position)
  171.                            (make-instance 'cancel-btn
  172.                              :view-position cancel-button-position)))))
  173.         )
  174.   
  175. ;;(make-applescript-editor)
  176.  
  177. (defmethod ccl::set-view-size ((window AS-EDITOR-WINDOW) h &optional v)
  178.   ;;  do the regular thing
  179.   (declare (ignore v))
  180.   (call-next-method)
  181.   ;;  resize the input-buffer proportionally
  182.   
  183.   (let* ((v-offset 20)
  184.          (h-offset 15)
  185.          (dialog-width (point-h h))
  186.          (dialog-height (point-v h))
  187.          (reserve-for-button 50)
  188.          (button-margin (floor
  189.                          (/ (- dialog-width
  190.                                280 ;sum of buttons
  191.                                ) 2)))
  192.          (run-button-position nil)
  193.          (add-button-position nil)
  194.          (cancel-button-position nil))
  195.     (setf run-button-position
  196.           (make-point button-margin 
  197.                       (- dialog-height 25)))
  198.     (setf add-button-position 
  199.           (make-point (+ 10 (point-h run-button-position)
  200.                          100)
  201.                       (point-v run-button-position)))
  202.     (setf cancel-button-position
  203.           (make-point (+ 10 (point-h add-button-position) 100)
  204.                       (point-v run-button-position)))
  205.     (set-view-size (view-named 'input-buffer window) 
  206.                    (- dialog-width h-offset)
  207.                    (- dialog-height  v-offset  reserve-for-button))
  208.     (set-view-position (view-named 'run-btn window) (point-h run-button-position)
  209.                    (point-v run-button-position))
  210.     (set-view-position (view-named 'add-btn window) (point-h add-button-position)
  211.                    (point-v add-button-position))
  212.     (set-view-position (view-named 'cancel-btn window) (point-h cancel-button-position)
  213.                    (point-v cancel-button-position))
  214.     )
  215.   )
  216.  
  217. ;; Method for editing scripts using the applescript-editor
  218.  
  219. (DEFMETHOD EDIT-SCRIPT ((ASO APPLESCRIPT-OBJECT))
  220.   (declare (special  *AS-SCRIPT-EDITOR*))
  221.   (let ((script (script ASO))
  222.         (theApp (application-name ASO)))
  223.     (if (and script
  224.              (not (cl-user:null-string-p script)))
  225.       (progn
  226.         (make-applescript-editor ASO)
  227.         (show-script *AS-SCRIPT-EDITOR* script))
  228.       (progn
  229.         (make-applescript-editor ASO) 
  230.         (if theApp
  231.           (show-script *AS-SCRIPT-EDITOR* 
  232.                        (concatenate 'string "tell application"
  233.                                    (cl-user:make-literal-string theApp)
  234.                                    " to")))))
  235.     )
  236.   )
  237.  
  238.  
  239.  
  240. ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  241.  
  242. (defclass aso-create-btn (ccl::button-dialog-item)
  243.   ()
  244.   (:default-initargs
  245.     :view-nick-name 'save
  246.     :default-button t
  247.     :dialog-item-text "Save"
  248.     :view-position #@(13 237)
  249.     :view-size #@(62 16)
  250.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  251.     )
  252.   )
  253.  
  254. (defclass aso-abort-btn (ccl::button-dialog-item)
  255.   ()
  256.   (:default-initargs
  257.     :view-nick-name 'abort
  258.     :dialog-item-text "Abort"
  259.     :view-position #@(11 271)
  260.     :view-size #@(62 16)
  261.     :view-font '("Chicago" 12 :SRCOR :PLAIN)
  262.     )
  263.   )
  264. ;;;  An applescript object editor - which generates an applescript object with
  265. ;;;  an editcript pane.
  266.  
  267. (defun make-aso-editor (&optional applescript-object)
  268.   ;;  
  269.   (let*  ((window (make-instance 'AS-editor-window
  270.                   :window-title "Applescript object builder"
  271.                   :color-p t
  272.                   :view-position #@(45 100)
  273.                   :view-size #@(450 325)
  274.                   ))
  275.           (as-edit-buffer (make-instance 'as-input-buffer
  276.                            :view-position #@(130 90)
  277.                            :view-size #@(290 200)
  278.                            :view-nick-name 'input-buffer))
  279.           
  280.           (app-name-label (make-instance 'STATIC-TEXT-DIALOG-ITEM
  281.                             :view-position #@(6 31) 
  282.                             :view-size #@(128 21)
  283.                             :dialog-item-text "Application name"
  284.                             ))
  285.           
  286.           (as-radio (make-instance 'RADIO-BUTTON-DIALOG-ITEM
  287.                       :view-position #@(10 96)
  288.                       :view-size #@(97 16)
  289.                       :dialog-item-text "AppleScript"
  290.                       :radio-button-pushed-p t))
  291.           
  292.           (app-name-field (make-instance 'EDITABLE-TEXT-DIALOG-ITEM
  293.                            :view-position #@(142 34) 
  294.                            :view-size #@(167 17)
  295.                            :view-nick-name 'app-name))
  296.           
  297.           (ht-radio (make-instance 'RADIO-BUTTON-DIALOG-ITEM
  298.                       :view-position #@(10 120)
  299.                       :view-size #@(88 16)
  300.                       :dialog-item-text "HyperTalk"
  301.                       :dialog-item-enabled-p nil))
  302.           (qk-radio (make-instance 'RADIO-BUTTON-DIALOG-ITEM
  303.                       :view-position #@(10 146)
  304.                       :view-size #@(93 16)
  305.                       :dialog-item-text "QuickKeys"
  306.                       :dialog-item-enabled-p nil))
  307.           (create-btn (make-instance 'ASO-CREATE-BTN))
  308.           (abort-btn (make-instance 'ASO-ABORT-BTN))
  309.            )
  310.     (add-subviews window as-edit-buffer app-name-field app-name-label
  311.                                as-radio ht-radio
  312.                                qk-radio create-btn abort-btn)
  313.     (cond (applescript-object
  314.            (set-dialog-item-text as-edit-buffer (or (script applescript-object)
  315.                                                     ""))
  316.            (set-dialog-item-text app-name-field (or (application-name applescript-object)
  317.                                                     ""))
  318.            (radio-button-push (case (scripting-component-type applescript-object)
  319.                                 ((:|ascr| $AppleScript) as-radio))))
  320.           (t (setf applescript-object (make-instance 'applescript-object))
  321.              ))
  322.     (setf (current-object window) applescript-object)
  323.     window))
  324.  
  325.  
  326. ;;  
  327. (defmethod ccl::dialog-item-action ((btn aso-create-btn))
  328.   ;;  gather up all the information in the views of the window and change the
  329.   ;;  values in the applescript-object
  330.   (let* ((win (view-container btn))
  331.          ;;  this is only applescript
  332.          (script.type (string-downcase (dialog-item-text (pushed-radio-button win 0))))
  333.          (appname (dialog-item-text (view-named 'app-name win)))
  334.          (script (extract-script-text (dialog-item-text (view-named 'input-buffer win))))
  335.          (as-object (current-object win)))
  336.     
  337.     ;;  set the values in the current object of the window
  338.     (setf (application-name as-object) appname
  339.           (script as-object) script
  340.           (compiled-script as-object) nil     ; script changed, recompile
  341.           (scripting-component-type as-object) (if (string= script.type
  342.                                                          "applescript")
  343.                                                   $AppleScript
  344.                                                   $HyperTalk))
  345.     )
  346.   )
  347.  
  348. ;;  what should abort do?  SHould it revert all the fields to the original
  349. ;;  state, or should it just put everything away and quit?  I choose the latter. 
  350. (defmethod ccl::dialog-item-action ((btn aso-abort-btn))
  351.   ;;  gather up all the information in the views of the window and change the
  352.   ;;  values in the applescript-object
  353.   (let ((win (view-container btn)))
  354.     (setf (current-object win) nil)
  355.     (set-dialog-item-text (view-named 'app-name win) "")
  356.     (set-dialog-item-text (view-named 'input-buffer win) "")
  357.     (window-close win)
  358.     )
  359.   )
  360.  
  361.  
  362. (defmethod edit-applescript-object ((aso applescript-object))
  363.   (make-aso-editor aso))
  364.  
  365. ;;(setf ttest (make-instance 'applescript-object))
  366. ;;(edit-applescript-object ttest)
  367.  
  368.  
  369.  
  370. (provide :as-edit)
  371.  
  372.  
  373.